home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Presentations / Presentations ’94 / Timothy Knox / Help / start < prev   
Encoding:
Text File  |  1994-06-24  |  3.8 KB  |  133 lines  |  [TEXT/Help]
  1. {•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}
  2. {•••                        Help start file for rel 1.4                    •••}
  3. {•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}
  4.  
  5. {••• The backquote. The following code should not be removed or modified ! •••}
  6.  
  7. (define (system:quasiquote s)
  8.    (cond (null? s) ()
  9.          (atom? s) (list 'quote s)
  10.          (eq? (0 s) 'unquote) (1 s)
  11.          (cons? (0 s)) (cond (eq? (0 (0 s)) 'unquote-splicing)
  12.                                  (if (null? (-1 s)) (1 (0 s))
  13.                                      (list 'append (1 (0 s)) (system:quasiquote (-1 s))))
  14.                                 † (list 'cons (system:quasiquote (0 s))
  15.                                               (system:quasiquote (-1 s))))
  16.          † (list 'cons (system:quasiquote (0 s))
  17.                        (system:quasiquote (-1 s)))))
  18.  
  19. (defmacro (quasiquote s) (system:quasiquote s))
  20. (defmacro (unquote | s) 'unquote)
  21. (defmacro (unquote-splicing | s) 'unquote-splicing)
  22.  
  23. {••• Reading a CODE ressource inside Help to include external code •••}
  24.  
  25. (defmacro (defext fic seg nom xref str | arg)
  26.   `(begin (define (,nom ,@arg))
  27.           (coerce ,nom 13)
  28.           (force (car=! ,nom (getext ,xref ,seg ,fic)))
  29.           (coerce ,nom 12)
  30.           (setstrict ,nom ,str) ',nom))
  31.  
  32. {••• The kappa syntaxic form is as lambda, but defines STRICT procedures •••}
  33.  
  34. (defmacro (kappa | l)
  35.   `(setstrict (lambda ,@l) %1111111111111111))
  36.  
  37. {••• The defkap syntaxic form is as define but defines STRICT procedures •••}
  38.  
  39. (defmacro (defkap f | b)
  40.   (cond (cons? f) `(define ,(0 f) 
  41.                            (setstrict (lambda ,(-1 f) ,@b) %1111111111111111))
  42.         `(define ,f ,@b)))
  43.  
  44. {••• Some procedures that should be assembly code translated… •••}
  45.  
  46. (define (append l1 l2)
  47.       (cond (null? l1) l2
  48.             (cons (0 l1) (append (-1 l1) l2))))
  49.  
  50. (define (reverse l | bag)
  51.       (cond (null? l) bag
  52.             (apply reverse (cons (-1 l)(cons (0 l) bag)))))
  53.  
  54. (defkap (memq? o l)
  55.    (cond (null? l) ƒ
  56.          (eq? o (0 l)) l
  57.          (memq? o (-1 l))))
  58.  
  59. (defkap (mem=? o l)
  60.    (cond (null? l) ƒ
  61.          (=? o (0 l)) l
  62.          (mem=? o (-1 l))))
  63.  
  64. (defkap (equal? l1 l2)
  65.   (cond (=? l1 l2) †
  66.         (cons? l1)(and (cons? l2)(equal? (0 l1)(0 l2))(equal? (-1 l1)(-1 l2)))))
  67.  
  68. (defkap (member? o l)
  69.    (cond (null? l) ƒ
  70.          (equal? o (0 l)) l
  71.          (member? o (-1 l))))
  72.  
  73. (defkap (nequal? l1 l2)
  74.   (not (equal? l1 l2)))
  75.  
  76. {••• Procedures on ORDERED number STREAMS •••}
  77.      
  78. (defkap (union l1 l2)
  79.     (cond (<? (0 l1)(0 l2))(cons (0 l1) (union (-1 l1) l2))
  80.           (=? (0 l1)(0 l2))(cons (0 l1)(union (-1 l1)(-1 l2)))
  81.           (cons (0 l2) (union l1 (-1 l2)))))
  82.  
  83. (defkap (inter l1 l2)
  84.     (cond (<? (0 l1)(0 l2)) (inter (-1 l1) l2)
  85.           (=? (0 l1)(0 l2))(cons (0 l1)(inter (-1 l1)(-1 l2)))
  86.           (inter l1 (-1 l2))))
  87.  
  88. (defkap (diff l1 l2)
  89.      (cond (=? (0 l1)(0 l2)) (diff (-1 l1) l2)
  90.            (<? (0 l1)(0 l2)) (cons (0 l1) (diff (-1 l1) l2))
  91.           (diff l1 (-1 l2))))
  92.  
  93. {••• Some good old combinators •••}
  94.  
  95. (define (I x) x)
  96.  
  97. (define Y 
  98.   ((lambda(a)
  99.     (lambda(b) (b ((a a) b)))) (lambda(a)
  100.                                  (lambda(b) (b ((a a) b))))))
  101.  
  102. {••• The map closure, should also be assembly coded •••}
  103.  
  104. (define (map f | l)
  105.  (amap f l))
  106.  
  107. (defkap (amap f l)
  108.  (cond (atom? f)(apply f l)
  109.        (cons (amap (0 f) (allcar l))
  110.                    (amap (-1 f) (allcdr l)))))
  111.  
  112. (defkap (allcar l)
  113.   (cond (null? l) ()
  114.         (cons (0 (0 l)) (allcar (-1 l)))))
  115.  
  116. (defkap (allcdr l)
  117.   (cond (null? l) ()
  118.         (cons (-1(0 l)) (allcdr (-1 l)))))
  119.  
  120. {••• Some closures for streams •••}
  121.  
  122. (define (consif kar kdr)
  123.   (cond kar (cons kar kdr)
  124.         kdr))
  125.  
  126. (define (reduce f b l)
  127.    (cond (null? l) b
  128.          (f (0 l) (reduce f b (-1 l)))))
  129.          
  130. (define (suchas p f)
  131.   (cond (p (0 f)) (cons (0 f) (suchas p (-1 f)))
  132.         (suchas p (-1 f))))
  133.